(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * shell.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Seppo_lib
open Astring

(* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)

let ( >>= ) = Result.bind
let ( let* ) = Result.bind

let log_dir = "app/var/log/"
let log_file = log_dir ^ "seppo.log"

let err i msgs =
  let exe = Filename.basename Sys.executable_name in
  msgs |> List.cons exe |> String.concat ~sep:": " |> prerr_endline;
  i

let exec (args : string list) =
  let print_version oc =
    let exe = Filename.basename Sys.executable_name in
    Printf.fprintf oc "%s: https://Seppo.mro.name/v/%s+%s\n" exe Version.dune_project_version Version.git_sha;
    0
  and print_help oc =
    let _exe = Filename.basename Sys.executable_name in
    Printf.fprintf oc
      {|Some basic tasks on Seppo.mro.name installations.

If run from commandline:

OPTIONS

  --help, -h
      print this help

  --version, -V
      print version

COMMANDS

  cron
      trigger job queue processing. Do this < every %i minutes to prevent the http loop.
  queue stats
      print stats about queued jobs.
  abs2id
      make absolute urls relative to base.
  ids
      dump ids.
  id2page
      look up page indexes for ids.
  page2s
      look up posts for page indexes.
  s2atom
      turn posts to an atom feed.
  make <files>
      refresh if necessary.
  doap
      show 'description of a project'.
  dot
      print file dependencies

  note < msg
      post a message
|} (Cron.max_age_s /. 60. |> int_of_float);
(*
      "\n\
      \  info\n\
      \      tell more about this instance\n\n\
      \  key-rotate\n\
      \      generate new keys\n\n\
      \  make\n\
      \      'make' file dependencies\n\n\
      \  tag sift\n\
      \      filter stdin to stdout\n\n\
      \  activitypub\n\
      \      make activitypub/index.json\n\n"; *)
    0
  and oc = stdout in
  let tail s = function
    | Error e ->
      Logr.err (fun m -> m "%s '%s': %s" E.e1004 s e);
      1
    | Ok _ ->
      Logr.info (fun m -> m "%s." s);
      0
  in
  let rz = Ap.Followers.Atom.rule
           :: Ap.Followers.Json.rule
           :: Ap.Following.Subscribed_to.Atom.rule
           :: Ap.Following.Subscribed_to.Json.rule
           :: Ap.Person.rule
           :: Ap.PersonX.rule
           :: Ap.PubKeyPem.pk_rule
           :: Ap.PubKeyPem.rule
           :: Main.Note.Atom.rule
           :: Webfinger.rule
           :: Webfinger.Server.rule
           :: [] in
  match args with
  | [ _; "-h" ] | [ _; "--help" ] -> print_help oc
  | [ _; "-V" ] | [ _; "--version" ] -> print_version oc
  | [ a0; "cron" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    Logr.open_out log_file;
    (match Cfg.Base.(from_file fn) with
     | Error _ -> failwith __LOC__
     | Ok base ->
       match Lwt_main.run (Cron.process_queue ~base) with
       | Error _ -> 1
       | Ok _  -> 0)
  | [ a0; "queue"; "stats" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match Main.Queue.(stats stderr oc qn) with
     | Error _ -> 1
     | Ok _  -> 0)
  | [ a0; "abs2id" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match Cfg.Base.(from_file fn) with
     | Error _ -> failwith __LOC__
     | Ok base ->
       File.fold_lines (fun init li ->
           let u = li
                   |> Uri.of_string
                   |> Http.abs_to_rel ~base in
           Format.printf "%a\n" Uri.pp u;
           init) 0 stdin )
  | [ a0; "ids" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    Mcdb.fold_left (fun init (id,_) ->
        print_bytes id;
        print_newline ();
        init) 0 Storage.fn_id_cdb
  | [ a0; "id2page" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    File.fold_lines (fun init li ->
        match li
              |> Uri.of_string
              |> Storage.TwoPad10.from_id with
        | Error e ->
          prerr_string e;
          init
        | Ok ix ->
          ix
          |> Storage.TwoPad10.to_string
          |> print_string;
          init) 0 stdin
  | [ a0; "page2s" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match stdin |> Csexp.input_many with
     | Error e -> prerr_string e;
       1
     | Ok sx ->
       let l = sx
               |> List.rev
               |> Storage.TwoPad10.decode_many in
       Storage.fn |> File.in_channel
         (fun ic ->
            List.fold_left (fun init (p0,p1) ->
                seek_in ic p0;
                really_input_string ic (p1-p0)
                |> print_string;
                init)
              0
              l ) )
  | [ a0; "s2atom" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match Cfg.Base.(from_file fn) with
     | Error _ -> failwith __LOC__
     | Ok base ->
       match stdin |> Csexp.input_many with
       | Error e -> prerr_string e;
         1
       | Ok sx ->
         let fxo x = Xmlm.output_doc_tree
             (fun x -> x)
             (Xmlm.make_output ~decl:false (`Channel stdout))
             (None,x) in
         `El (((Xml.ns_a,"feed"),[
             ((Xmlm.ns_xmlns,"xmlns"),Xml.ns_a);
             ((Xmlm.ns_xmlns,"wf"),Xml.ns_rfc7033);
             (* ((Xmlm.ns_xml,"lang"),lang); *)
             ((Xmlm.ns_xml,"base"),base |> Uri.to_string);
           ]),
              List.fold_left (fun init sx ->
                  match sx |> Rfc4287.Entry.decode with
                  | Error e -> Printf.eprintf "error: %s\n" e;
                    init
                  | Ok e ->
                    (e |> Rfc4287.Entry.to_atom ~base)
                    :: init )
                [] sx )
         |> fxo;
         0 )
  | _ :: ("make" as cmd) :: files ->
    Logr.info (fun m -> m "%s %s" cmd (String.concat ~sep:" " files));
    files
    |> List.fold_left
      (fun a fn -> Result.bind a (fun _ -> Make.M2.make rz fn) )
      (Ok "")
    |> tail cmd
  | [ _; "doap" ] ->
    (match "doap.rdf" |> Res.read with
     | Some v -> Printf.fprintf oc "%s" v
     | None -> ());
    0
  | [ _b; "note" ] ->
    (let* base,profile,author = Main.Note.load_basics () in
     let* pk                  = Ap.PubKeyPem.(private_of_pem pk_pem) in
     let key_id               = Ap.Person.my_key_id ~base in
     let key                  = Http.Signature.mkey key_id pk in
     let* _ =
       stdin
       |> Rfc4287.Entry.from_channel ~author ~lang:profile.language ~tz:profile.timezone
       >>= Main.sift_urls
       >>= Main.sift_tags Tag.cdb
       >>= Main.sift_handles
       >>= Main.Note.publish ~base ~profile ~author
       >>= Main.Note.Create.notify_subscribers ~base in
     Lwt_main.run (Main.Queue.process_new_and_due ~base ~key Main.Queue.qn)
    ) |> tail "note"
  | [ _; "info" ] ->
    0
(*
      | [ _; "append" ] -> (
      let now = (Ptime_clock.now (), Ptime_clock.current_tz_offset_s ()) in
      match Txt.of_channel now [] stdin with
      | Ok e -> (
          match Sepp0.append e with Ok _ -> 0 | Error s -> err 4 [ s ])
      | Error _ -> err 5 [ "ouch 300" ])
*)
  | [ _; "dot" ] ->
    ( match Make.dot oc rz with
      | Error _ -> 1
      | Ok _ -> 0)
  | [ _; "tag"; "sift" ] -> (
      match Tag.sift_channel stdin with
      | Error _ -> 1
      | Ok l ->
        l |> List.iter (fun (Tag.Tag s) -> Printf.printf "%s\n" s);
        0)
  | [ _; "activitypub" as cmd ] -> (
      Make.make rz Ap.Person.target
      |> tail cmd
    )
  | _ -> err 2 [ "get help with -h" ]
